home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 376-400 / disk_386 / xlispstat / src2.lzh / XLisp-Stat / xsiviewwin2.c < prev    next >
C/C++ Source or Header  |  1990-10-04  |  25KB  |  878 lines
  1. /* xsiviewwin2 - XLISP interface to IVIEW dynamic graphics package.    */
  2. /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
  3. /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
  4. /* You may give out copies of this software; for conditions see the    */
  5. /* file COPYING included with this distribution.                       */
  6.  
  7. #include "xlisp.h"
  8. #include "osdef.h"
  9. #ifdef ANSI
  10. #include "xlproto.h"
  11. #include "xlsproto.h"
  12. #include "iviewproto.h"
  13. #include "Stproto.h"
  14. #else
  15. #include "xlfun.h"
  16. #include "xlsfun.h"
  17. #include "iviewfun.h"
  18. #include "Stfun.h"
  19. #endif ANSI
  20. #include "xlsvar.h"
  21.  
  22. /* forward declarations */
  23. #ifdef ANSI
  24. void button_down_action(IVIEW_WINDOW,int,int),free_poly(short *),
  25.      free_image(char *);
  26. short *make_poly(LVAL,int *);
  27. char *make_image(LVAL);
  28. LVAL window_state(int),has_scroll(int),scroll_increments(int),draw(int,int),
  29.      draw_poly(int),text(int,int),buffer(int);
  30. #else
  31. void button_down_action(),free_poly(),
  32.      free_image();
  33. short *make_poly();
  34. char *make_image();
  35. LVAL window_state(),has_scroll(),scroll_increments(),draw(),
  36.      draw_poly(),text(),buffer();
  37. #endif ANSI
  38.  
  39. /**************************************************************************/
  40. /**                                                                      **/
  41. /**                      Window Management Functions                     **/
  42. /**                                                                      **/
  43. /**************************************************************************/
  44.  
  45. /* :REMOVE message for IVIEW-WINDOW-CLASS */
  46. LVAL iview_window_remove()
  47. {
  48.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  49.   LVAL object;
  50.   
  51.   object = xlgaobject();
  52.   gwinfo = StGWObWinInfo(object);
  53.   xllastarg();
  54.   
  55.   if (gwinfo != nil) {
  56.     StGWRemove(gwinfo);
  57.     standard_hardware_clobber(object);
  58.   }
  59.   return(NIL);
  60. }
  61.  
  62. static LVAL button_fcn;
  63.  
  64. static void button_down_action(w, x, y)
  65.      IVIEW_WINDOW w;
  66.      int x, y;
  67. {
  68.   LVAL Lx, Ly;
  69.  
  70.   xlsave1(Lx);
  71.   xlsave1(Ly);
  72.   Lx = cvfixnum((FIXTYPE) x);
  73.   Ly = cvfixnum((FIXTYPE) y);
  74.   xsfuncall2(button_fcn, Lx, Ly);
  75.   xlpopn(2);
  76. }
  77.  
  78. LVAL iview_window_while_button_down()
  79. {
  80.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  81.   int motionOnly;
  82.   
  83.   gwinfo = StGWObWinInfo(xlgaobject());
  84.   button_fcn = xlgetarg();
  85.   motionOnly = (! moreargs() || xlgetarg() != NIL) ? TRUE : FALSE;
  86.   xllastarg();
  87.   
  88.   StGWWhileButtonDown(gwinfo, button_down_action, motionOnly);
  89.   
  90.   return(NIL);
  91. }
  92.  
  93. /**************************************************************************/
  94. /**                                                                      **/
  95. /**             Window State Access and Mutation Functions               **/
  96. /**                                                                      **/
  97. /**************************************************************************/
  98.  
  99. ColorCode decode_lisp_color(arg)
  100.     LVAL arg;
  101. {
  102.   LVAL val;
  103.   
  104.   val = xlgetprop(arg, s_color_index);
  105.   if (! fixp(val)) xlerror("unknown color", arg);
  106.   else return((ColorCode)getfixnum(val));
  107. }
  108.  
  109. LVAL encode_lisp_color(color)
  110.     /*int*/ ColorCode color; /* changed JKL */
  111. {
  112.   LVAL sym;
  113.   
  114.   sym = (LVAL) StGWGetColRefCon(color);
  115.   if (! symbolp(sym)) xlfail("unknown color");
  116.   return(sym);
  117. }
  118.  
  119. static LVAL window_state(var)
  120.      int var;
  121. {
  122.   LVAL object, arg, result;
  123.   int value, set = FALSE;
  124.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  125.   
  126.   object = xlgaobject();
  127.   gwinfo = StGWObWinInfo(object);
  128.   if (gwinfo == nil) return(NIL);
  129.   
  130.   if (moreargs()) {
  131.     set = TRUE;
  132.     arg = (var != 'C') ? xlgasymbol() : xlgetarg();
  133.   }
  134.   xllastarg();
  135.  
  136.   if (set) {
  137.     /* decode lisp argument */
  138.     switch (var) {
  139.     case 'T':
  140.       if (arg == s_solid) value = 0;
  141.       else if (arg == s_dashed) value = 1;
  142.       else xlerror("unknown line type", arg);
  143.       break;
  144.     case 'M':
  145.       if (arg == s_normal) value = 0;
  146.       else if (arg == s_xor) value = 1;
  147.       else xlerror("unknown drawing mode", arg);
  148.       break;
  149.     case 'D':
  150.     case 'B': value = decode_lisp_color(arg); break;
  151.     case 'C': value = (arg != NIL) ? TRUE : FALSE; break;
  152.     default: xltoomany();
  153.     }
  154.   
  155.     /* set the state variable */
  156.     switch (var) {
  157.     case 'T':  StGWSetLineType(gwinfo, value); break;
  158.     case 'M':  StGWSetDrawMode(gwinfo, value); break;
  159.     case 'D':  StGWSetDrawColor(gwinfo, (ColorCode) value); break;
  160.     case 'B':  StGWSetBackColor(gwinfo, (ColorCode) value); break;
  161.     case 'C':  StGWSetUseColor(gwinfo, (ColorCode) value); break;
  162.     }                               /*cast added JKL */
  163.   }
  164.  
  165.   /* read the state variable */
  166.   switch (var) {
  167.   case 'W':  value = StGWCanvasWidth(gwinfo); break;
  168.   case 'H':  value = StGWCanvasHeight(gwinfo); break;
  169.   case 'T':  value = StGWLineType(gwinfo); break;
  170.   case 'M':  value = StGWDrawMode(gwinfo); break;
  171.   case 'D':  value = (int) StGWDrawColor(gwinfo); break;
  172.   case 'B':  value = (int) StGWBackColor(gwinfo); break;
  173.   case 'C':  value = StGWUseColor(gwinfo); break;
  174.   case 'R':  StGWReverseColors(gwinfo); 
  175.              value = StGWBackColor(gwinfo);
  176.              break;
  177.   }
  178.   
  179.   /* encode result as lisp value */
  180.   switch (var) {
  181.   case 'W':
  182.   case 'H': result = cvfixnum((FIXTYPE) value); break;
  183.   case 'T': result = (value == 0) ? s_solid : s_dashed; break;
  184.   case 'M': result = (value == 0) ? s_normal : s_xor; break;
  185.   case 'D':
  186.   case 'B':              /* cast added JKL */
  187.   case 'R': result = encode_lisp_color((ColorCode) value); break;
  188.   case 'C': result = (value) ? s_true : NIL; break;
  189.   }
  190.   
  191.   return(result);
  192. }
  193.  
  194. LVAL iview_window_canvas_width()   { return(window_state('W')); }
  195. LVAL iview_window_canvas_height()  { return(window_state('H')); }
  196. LVAL iview_window_line_type()      { return(window_state('T')); }
  197. LVAL iview_window_draw_mode()      { return(window_state('M')); }
  198. LVAL iview_window_draw_color()     { return(window_state('D')); }
  199. LVAL iview_window_back_color()     { return(window_state('B')); }
  200. LVAL iview_window_use_color()      { return(window_state('C')); } 
  201. LVAL iview_window_reverse_colors() { return(window_state('R')); } 
  202.  
  203. LVAL iview_window_view_rect()
  204. {
  205.   LVAL object;
  206.   int left, top, width, height;
  207.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  208.   
  209.   object = xlgaobject();
  210.   xllastarg();  
  211.   
  212.   gwinfo = StGWObWinInfo(object);
  213.   if (gwinfo == nil) return(NIL);
  214.   else {
  215.     StGWGetViewRect(gwinfo, &left, &top, &width, &height);
  216.     return(integer_list_4(left, top, width, height));
  217.   }
  218. }
  219.  
  220. LVAL iview_window_line_width()
  221. {
  222.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  223.   int width, set = FALSE;
  224.   
  225.   gwinfo = StGWObWinInfo(xlgaobject());
  226.   if (gwinfo == nil) return(NIL);
  227.   
  228.   if (moreargs()) {
  229.     set = TRUE;
  230.     width = getfixnum(xlgafixnum());
  231.   }
  232.   xllastarg();
  233.   
  234.   if (set) StGWSetLineWidth(gwinfo, width);
  235.   StGWGetLineWidth(gwinfo, &width);
  236.   return(cvfixnum((FIXTYPE) width));
  237. }
  238.  
  239. /**************************************************************************/
  240. /**                                                                      **/
  241. /**                       Window Scrolling Functions                     **/
  242. /**                                                                      **/
  243. /**************************************************************************/
  244.  
  245. static LVAL has_scroll(which)
  246.      int which;
  247. {
  248.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  249.   int has, size, width, height, set = FALSE;
  250.   LVAL arg;
  251.   
  252.   gwinfo = StGWObWinInfo(xlgaobject());
  253.   if (gwinfo == nil) return(NIL);
  254.   
  255.   if (moreargs()) {
  256.     set = TRUE;
  257.     arg = xlgetarg();
  258.     has = (arg != NIL) ? TRUE : FALSE;
  259.     if (has && arg == s_true) {
  260.       StGetScreenSize(&width, &height);
  261.       size = (width > height) ? width : height;
  262.     }
  263.     else if (has) {
  264.       if (! fixp(arg)) xlerror("bad canvas size", arg);
  265.       size = getfixnum(arg);
  266.     }
  267.     else size = 0;
  268.   }
  269.   xllastarg();
  270.   
  271.   if (set) 
  272.     switch (which) {
  273.     case 'H': StGWSetHasHscroll(gwinfo, has, size); break;
  274.     case 'V': StGWSetHasVscroll(gwinfo, has, size); break;
  275.     }
  276.   switch (which) {
  277.   case 'H': has = StGWHasHscroll(gwinfo); break;
  278.   case 'V': has = StGWHasVscroll(gwinfo); break;
  279.   }
  280.   return((has) ? s_true : NIL);
  281. }
  282.  
  283. LVAL iview_window_has_h_scroll() { return(has_scroll('H')); }
  284. LVAL iview_window_has_v_scroll() { return(has_scroll('V')); }
  285.  
  286. LVAL iview_window_scroll()
  287. {
  288.   LVAL object;
  289.   int h, v, set = FALSE;
  290.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  291.   
  292.   object = xlgaobject();
  293.   gwinfo = StGWObWinInfo(object);
  294.   if (gwinfo == nil) return(NIL);
  295.   
  296.   if (moreargs()) {
  297.     set = TRUE;
  298.     h = getfixnum(xlgafixnum());
  299.     v = getfixnum(xlgafixnum());
  300.   }    
  301.   xllastarg();
  302.   
  303.   if (set) StGWSetScroll(gwinfo, h, v, TRUE);
  304.   StGWGetScroll(gwinfo, &h, &v);
  305.   
  306.   return(integer_list_2(h, v));
  307. }
  308.  
  309. static LVAL scroll_increments(which)
  310.         int which;
  311. {
  312.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  313.   int inc, pageinc;
  314.   
  315.   gwinfo = StGWObWinInfo(xlgaobject());
  316.   if (gwinfo == nil) return(NIL);
  317.   
  318.   if (moreargs()) {
  319.     inc = getfixnum(xlgafixnum());
  320.     pageinc = getfixnum(xlgafixnum());
  321.     switch(which) {
  322.     case 'H': StGWSetHscrollIncs(gwinfo, inc, pageinc); break;
  323.     case 'V': StGWSetVscrollIncs(gwinfo, inc, pageinc); break;
  324.     }
  325.   }
  326.   switch (which) {
  327.   case 'H': StGWGetHscrollIncs(gwinfo, &inc, &pageinc); break;
  328.   case 'V': StGWGetVscrollIncs(gwinfo, &inc, &pageinc); break;
  329.   }
  330.   
  331.   return(integer_list_2(inc, pageinc));
  332. }
  333.  
  334. LVAL iview_window_h_scroll_incs() { return(scroll_increments('H')); }
  335. LVAL iview_window_v_scroll_incs() { return(scroll_increments('V')); }
  336.  
  337. /**************************************************************************/
  338. /**                                                                      **/
  339. /**                  Line and Rectangle Drawing Functions                **/
  340. /**                                                                      **/
  341. /**************************************************************************/
  342.  
  343. static LVAL draw(what, how)
  344.         int what, how;
  345. {
  346.   LVAL object;
  347.   int a, b, c, d;
  348.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  349.   double angle1, angle2;
  350.   
  351.   object = xlgaobject();
  352.   gwinfo = StGWObWinInfo(object);
  353.   if (gwinfo == nil) return(NIL);
  354.   
  355.   a = getfixnum(xlgafixnum());
  356.   b = getfixnum(xlgafixnum());
  357.   if (what != 'P') {
  358.     c = getfixnum(xlgafixnum());
  359.     d = getfixnum(xlgafixnum());
  360.   }
  361.   if (what == 'A') {
  362.     angle1 = makedouble(xlgetarg());
  363.     angle2 = makedouble(xlgetarg());
  364.   }
  365.   xllastarg();
  366.   
  367.   switch(what) {
  368.   case 'L': StGWDrawLine(gwinfo, a, b, c, d); break;
  369.   case 'P': StGWDrawPoint(gwinfo, a, b); break;
  370.   case 'R':
  371.     switch (how) {
  372.     case 'E': StGWEraseRect(gwinfo, a, b, c, d); break;
  373.     case 'F': StGWFrameRect(gwinfo, a, b, c, d); break;
  374.     case 'P': StGWPaintRect(gwinfo, a, b, c, d); break;
  375.     }
  376.     break;
  377.   case 'O':
  378.     switch (how) {
  379.     case 'E':  StGWEraseOval(gwinfo, a, b, c, d); break;
  380.     case 'F':  StGWFrameOval(gwinfo, a, b, c, d); break;
  381.     case 'P':  StGWPaintOval(gwinfo, a, b, c, d); break;
  382.     }
  383.     break;
  384.   case 'A':
  385.     switch (how) {
  386.     case 'E':  StGWEraseArc(gwinfo, a, b, c, d, angle1, angle2); break;
  387.     case 'F':  StGWFrameArc(gwinfo, a, b, c, d, angle1, angle2); break;
  388.     case 'P':  StGWPaintArc(gwinfo, a, b, c, d, angle1, angle2); break;
  389.     }
  390.     break;
  391.   }
  392.   return(NIL);
  393. }
  394.  
  395. LVAL iview_window_draw_line()   { return(draw('L', 'F')); }
  396. LVAL iview_window_draw_point()  { return(draw('P', 'F')); }
  397. LVAL iview_window_erase_rect()  { return(draw('R', 'E')); }
  398. LVAL iview_window_frame_rect()  { return(draw('R', 'F')); }
  399. LVAL iview_window_paint_rect()  { return(draw('R', 'P')); } 
  400. LVAL iview_window_erase_oval()  { return(draw('O', 'E')); }
  401. LVAL iview_window_frame_oval()  { return(draw('O', 'F')); }
  402. LVAL iview_window_paint_oval()  { return(draw('O', 'P')); }
  403. LVAL iview_window_erase_arc()   { return(draw('A', 'E')); }
  404. LVAL iview_window_frame_arc()   { return(draw('A', 'F')); }
  405. LVAL iview_window_paint_arc()   { return(draw('A', 'P')); }
  406.  
  407. static short *make_poly(poly, size)
  408.      LVAL poly;
  409.      int *size;
  410. {
  411.   LVAL temp, pt;
  412.   short *p;
  413.   int n, i;
  414.   
  415.   for (temp = poly, n = 0; consp(temp); temp = cdr(temp)) {
  416.     if (! consp(car(temp)) || ! fixp(car(car(temp))) 
  417.         || !  fixp(car(cdr(car(temp)))))
  418.       xlfail("bad polygon data");
  419.     n++;
  420.   }
  421.   if (n > 0) {
  422.     p = (short *) StCalloc(2 * n, sizeof(short));
  423.     for (i = 0; i < n; i++, poly = cdr(poly)) {
  424.       pt = car(poly);
  425.       p[2 * i] = getfixnum(car(pt));
  426.       p[2 * i + 1] = getfixnum(car(cdr(pt)));
  427.     }
  428.   }
  429.   else p = nil;
  430.   *size = n;
  431.   return(p);
  432. }
  433.  
  434. static void free_poly(p)
  435.      short *p;
  436. {
  437.   StFree(p);
  438. }
  439.  
  440. static LVAL draw_poly(how)
  441.      int how;
  442. {
  443.   LVAL object, poly;
  444.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  445.   short *p;
  446.   int n, from_origin;
  447.   
  448.   object = xlgaobject();
  449.   poly = xlgalist();
  450.   if (moreargs())
  451.     from_origin = (xlgetarg() != NIL) ? TRUE : FALSE;
  452.   else from_origin = TRUE;
  453.   xllastarg();
  454.  
  455.   gwinfo = StGWObWinInfo(object);
  456.   if (gwinfo == nil) return(NIL);
  457.   p = make_poly(poly, &n);
  458.   
  459.   if (p != nil) {
  460.     switch (how) {
  461.     case 'E': StGWErasePoly(gwinfo, n, p, from_origin); break;
  462.     case 'F': StGWFramePoly(gwinfo, n, p, from_origin); break;
  463.     case 'P': StGWPaintPoly(gwinfo, n, p, from_origin); break;
  464.     }
  465.     free_poly(p);
  466.   }
  467.   return(NIL);
  468. }
  469.  
  470. LVAL iview_window_erase_poly()   { return(draw_poly('E')); }
  471. LVAL iview_window_frame_poly()   { return(draw_poly('F')); }
  472. LVAL iview_window_paint_poly()   { return(draw_poly('P')); }
  473.  
  474. /**************************************************************************/
  475. /**                                                                      **/
  476. /**                            Text Functions                            **/
  477. /**                                                                      **/
  478. /**************************************************************************/
  479.  
  480. static LVAL text(what, up)
  481.      int what, up;
  482. {
  483.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  484.   char *s;
  485.   int value, x, y, h, v;
  486.  
  487.   gwinfo = StGWObWinInfo(xlgaobject());
  488.   if (gwinfo == nil) return(NIL);
  489.   
  490.   if (what != 'A' && what != 'd') s = (char *) getstring(xlgastring());
  491.   if (what != 'A' && what != 'W' && what != 'd') {
  492.     x = getfixnum(xlgafixnum());
  493.     y = getfixnum(xlgafixnum());
  494.   }
  495.   if (what == 'T') {
  496.     h = getfixnum(xlgafixnum());
  497.     v = getfixnum(xlgafixnum());
  498.   }
  499.   xllastarg();
  500.   
  501.   switch (what) {
  502.   case 'A':  value = StGWTextAscent(gwinfo); break;
  503.   case 'd':  value = StGWTextDescent(gwinfo); break;
  504.   case 'W':  value = StGWTextWidth(gwinfo, s); break;
  505.   case 'D':  if (up) StGWDrawStringUp(gwinfo, s, x, y);
  506.              else StGWDrawString(gwinfo, s, x, y);
  507.              break;
  508.   case 'T':  if (up) StGWDrawTextUp(gwinfo, s, x, y, h, v);
  509.              else StGWDrawText(gwinfo, s, x, y, h, v);
  510.              break;
  511.   }
  512.  
  513.   return((what == 'A' || what == 'W' || what == 'd') ? cvfixnum((FIXTYPE) value) : NIL);
  514. }
  515.  
  516. LVAL iview_window_text_ascent()    { return(text('A', FALSE)); }
  517. LVAL iview_window_text_descent()   { return(text('d', FALSE)); }
  518. LVAL iview_window_text_width()     { return(text('W', FALSE)); }
  519. LVAL iview_window_draw_string()    { return(text('D', FALSE)); }
  520. LVAL iview_window_draw_string_up() { return(text('D', TRUE));  }
  521. LVAL iview_window_draw_text()      { return(text('T', FALSE)); }
  522. LVAL iview_window_draw_text_up()   { return(text('T', TRUE));  }
  523.  
  524. /**************************************************************************/
  525. /**                                                                      **/
  526. /**                           Symbol Functions                           **/
  527. /**                                                                      **/
  528. /**************************************************************************/
  529.  
  530. LVAL iview_window_draw_symbol()
  531. {
  532.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  533.   LVAL symbol;
  534.   int sym, hsym, hilited, x, y;
  535.   
  536.   gwinfo = StGWObWinInfo(xlgaobject());
  537.   if (gwinfo == nil) return(NIL);
  538.   
  539.   symbol = xlgasymbol();
  540.   hilited = xlgetarg() != NIL;
  541.   x = getfixnum(xlgafixnum());
  542.   y = getfixnum(xlgafixnum());
  543.   xllastarg();
  544.  
  545.   decode_point_symbol(symbol, &sym, &hsym);
  546.   StGWDrawSymbol(gwinfo, (hilited) ? hsym : sym, x, y);
  547.   return(NIL);
  548. }
  549.  
  550. LVAL iview_window_replace_symbol()
  551. {
  552.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  553.   LVAL oldsymbol, newsymbol;
  554.   int oldsym, oldhsym, newsym, newhsym, oldhilited, newhilited, x, y;
  555.   
  556.   gwinfo = StGWObWinInfo(xlgaobject());
  557.   if (gwinfo == nil) return(NIL);
  558.   
  559.   oldsymbol = xlgasymbol();
  560.   oldhilited = xlgetarg() != NIL;
  561.   newsymbol = xlgasymbol();
  562.   newhilited = xlgetarg() != NIL;
  563.   x = getfixnum(xlgafixnum());
  564.   y = getfixnum(xlgafixnum());
  565.   xllastarg();
  566.  
  567.   decode_point_symbol(oldsymbol, &oldsym, &oldhsym);
  568.   decode_point_symbol(newsymbol, &newsym, &newhsym);
  569.   StGWReplaceSymbol(gwinfo, (oldhilited) ? oldhsym : oldsym, 
  570.                             (newhilited) ? newhsym : newsym, x, y);
  571.   return(NIL);
  572. }
  573.  
  574. /**************************************************************************/
  575. /**                                                                      **/
  576. /**                         Buffering Functions                          **/
  577. /**                                                                      **/
  578. /**************************************************************************/
  579.  
  580. static LVAL buffer(what)
  581.      int what;
  582. {
  583.   LVAL object;
  584.   int left, top, width, height;
  585.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  586.   
  587.   object = xlgaobject();
  588.   gwinfo = StGWObWinInfo(object);
  589.   if (gwinfo == nil) return(NIL);
  590.   
  591.   if (what == 'B') {
  592.     if (moreargs()) {
  593.       left = getfixnum(xlgafixnum());
  594.       top = getfixnum(xlgafixnum());
  595.       width = getfixnum(xlgafixnum());
  596.       height = getfixnum(xlgafixnum());
  597.     }
  598.     else StGWGetViewRect(gwinfo, &left, &top, &width, &height);
  599.   }
  600.   xllastarg();
  601.  
  602.   switch (what) {
  603.   case 'S':  StGWStartBuffering(gwinfo); break;
  604.   case 'B':  StGWBufferToScreen(gwinfo, left, top, width, height); break;
  605.   }
  606.   
  607.   return(NIL);
  608. }
  609.  
  610. LVAL iview_window_start_buffering()  { return(buffer('S')); }
  611. LVAL iview_window_buffer_to_screen() { return(buffer('B')); }
  612.  
  613. /**************************************************************************/
  614. /**                                                                      **/
  615. /**                         Clipping Functions                           **/
  616. /**                                                                      **/
  617. /**************************************************************************/
  618.  
  619. LVAL iview_window_clip_rect()
  620. {
  621.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  622.   int clipping, left, top, width, height;
  623.   
  624.   gwinfo = StGWObWinInfo(xlgaobject());
  625.   if (gwinfo == nil) return(NIL);
  626.   
  627.   if (moreargs()) {
  628.     clipping = (peekarg(0) != NIL);
  629.     if (clipping) {
  630.       left = getfixnum(xlgafixnum());
  631.       top = getfixnum(xlgafixnum());
  632.       width = getfixnum(xlgafixnum());
  633.       height = getfixnum(xlgafixnum());
  634.     }
  635.     StGWSetClipRect(gwinfo, clipping, left, top, width, height);
  636.   }
  637.   clipping = StGWGetClipRect(gwinfo, &left, &top, &width, &height);
  638.   return((clipping) ? integer_list_4(left, top, width, height) : NIL);
  639. }
  640.  
  641. /**************************************************************************/
  642. /**                                                                      **/
  643. /**                       Miscellaneous Functions                        **/
  644. /**                                                                      **/
  645. /**************************************************************************/
  646.  
  647. int decode_cursor(arg)
  648.     LVAL arg;
  649. {
  650.   LVAL val;
  651.   
  652.   val = xlgetprop(arg, s_cursor_index);
  653.   if (fixp(val)) return(getfixnum(val));
  654.   else return(ARROW_CURSOR);
  655. }
  656.  
  657. LVAL encode_cursor(cursor)
  658.      int cursor;
  659. {
  660.   LVAL sym;
  661.   
  662.   sym = (LVAL) StGWGetCursRefCon(cursor);
  663.   if (sym == NIL) sym = s_arrow;
  664.   if (! symbolp(sym)) xlfail("unknown cursor");
  665.   return(sym);
  666. }
  667.  
  668. LVAL iview_window_cursor()
  669. {
  670.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  671.   LVAL cursor;
  672.   
  673.   gwinfo = StGWObWinInfo(xlgaobject());
  674.   if (gwinfo == nil) return(NIL);
  675.   
  676.   if (moreargs()) {
  677.     cursor = xlgetarg();
  678.     StGWSetCursor(gwinfo, decode_cursor(cursor));
  679.   }
  680.   return(encode_cursor(StGWCursor(gwinfo)));
  681. }
  682.  
  683. LVAL iview_window_reset_buffer() { StGWResetBuffer(); return(NIL); }
  684.  
  685. LVAL iview_window_dump_image()
  686. {
  687.   /*char*/ StGWWinInfo *gwinfo; /* changed JKL */
  688.   LVAL fptr;
  689.   double scale;
  690.   
  691.   gwinfo = StGWObWinInfo(xlgaobject());
  692. #ifndef AMIGA  /* requires file name to open for low level write JKL */
  693.   fptr = xlgetfile();
  694. #else
  695.   fptr = xlgetarg();
  696. #endif AMIGA
  697.   scale = (moreargs()) ? makedouble(xlgetarg()) : 1.0;
  698. #ifndef AMIGA
  699.   /* make sure the file exists */
  700.   if (getfile(fptr) == NULL) xlfail("file not open");
  701.   
  702.   if (gwinfo != nil) StGWDumpImage(gwinfo, getfile(fptr), scale);
  703. #else
  704.   if (gwinfo != nil) StGWDumpImage(gwinfo, getstring(fptr), scale);
  705. #endif AMIGA
  706.   return(NIL);
  707. }  
  708.  
  709. LVAL gw_make_color()
  710. {
  711.   LVAL sym;
  712.   double red, green, blue;
  713.   int index;
  714.  
  715.   sym = xlgasymbol();
  716.   if (! syminterned(sym)) xlerror("symbol not interned", sym);
  717.   if (xlgetprop(sym, s_color_index) != NIL) {
  718.     StGWFreeColor(decode_lisp_color(sym));
  719.     xlputprop(sym, NIL, s_color_index);
  720.   }
  721.   red = makedouble(xlgetarg());
  722.   green = makedouble(xlgetarg());
  723.   blue = makedouble(xlgetarg());
  724.   xllastarg();
  725.   
  726.   index = StGWMakeColor(red, green, blue, sym);
  727.   if (index < 0) xlfail("can't allocate color");
  728.   xlputprop(sym, cvfixnum((FIXTYPE) index), s_color_index);
  729.   return(NIL);
  730. }
  731.  
  732. LVAL gw_free_color()
  733. {
  734.   LVAL sym;
  735.   
  736.   sym = xlgasymbol();
  737.   xllastarg();
  738.   
  739.   if (xlgetprop(sym, s_color_index) != NIL) {
  740.     StGWFreeColor(decode_lisp_color(sym));
  741.     xlputprop(sym, NIL, s_color_index);
  742.   }
  743.   return(NIL);
  744. }
  745.  
  746. static char *make_image(Limage)
  747.      LVAL Limage;
  748. {
  749.   int i, n;
  750.   char *image;
  751.   
  752.   Limage = arraydata(Limage);
  753.   n = getsize(Limage);
  754.   
  755.   for (i = 0; i < n; i++) if (! fixp(getelement(Limage, i))) return(nil);
  756.   image = StCalloc(n, 1);
  757.   for (i = 0; i < n; i++) 
  758.     image[i] = (getfixnum(getelement(Limage, i)) != 0) ? 1 : 0;
  759.   return(image);
  760. }
  761.  
  762. static void free_image(image)
  763.      char *image;
  764. {
  765.   if (image != nil) StFree(image);
  766. }
  767.  
  768. LVAL gw_make_cursor()
  769. {
  770.   LVAL sym, Limage, Lmask = NIL, curs;
  771.   int index = -1, n, h = 0, v = 0, num;
  772.   char *image, *mask = nil, *name;
  773.   
  774.   sym = xlgasymbol();
  775.   if (! syminterned(sym)) xlerror("symbol not interned", sym);
  776.   if (xlgetprop(sym, s_cursor_index) != NIL) {
  777.     StGWFreeCursor(decode_cursor(sym));
  778.     xlputprop(sym, NIL, s_cursor_index);
  779.   }
  780.   if (stringp(peekarg(0)) || fixp(peekarg(0))) {
  781.     curs = xlgetarg();
  782.     name = (stringp(curs)) ? (char *) getstring(curs) : nil;
  783.     num = (stringp(curs)) ? -1 : getfixnum(curs);
  784.     index = StGWMakeResCursor(name, num, sym);
  785.   }
  786.   else {
  787.     Limage = xsgetmatrix();
  788.     if (moreargs()) Lmask = xsgetmatrix();
  789.     if (moreargs()) h = getfixnum(xlgafixnum());
  790.     if (moreargs()) v = getfixnum(xlgafixnum());
  791.   
  792.     n = numrows(Limage);
  793.     if (n != numcols(Limage)) xlerror("not a square matrix", Limage);
  794.   
  795.     image = make_image(Limage);
  796.     if (Lmask != NIL && n == numrows(Lmask) && n == numcols(Lmask))
  797.       mask = make_image(Lmask);
  798.     if (image != nil) 
  799.       index = StGWMakeCursor(n, image, mask, h, v, sym);
  800.     if (image != nil) free_image(image);
  801.     if (mask != nil) free_image(mask);
  802.   }
  803.   if (index < 0) xlfail("can't allocate cursor");
  804.   xlputprop(sym, cvfixnum((FIXTYPE) index), s_cursor_index);
  805.   return(NIL);
  806. }
  807.  
  808. LVAL gw_free_cursor()
  809. {
  810.   LVAL sym;
  811.   
  812.   sym = xlgasymbol();
  813.   xllastarg();
  814.   
  815.   if (xlgetprop(sym, s_cursor_index) != NIL) {
  816.     StGWFreeCursor(decode_cursor(sym));
  817.     xlputprop(sym, NIL, s_cursor_index);
  818.   }
  819.   return(NIL);
  820. }
  821.  
  822. void decode_point_symbol(lsym, psym, phsym)
  823.      LVAL lsym;
  824.      int *psym, *phsym;
  825. {
  826.   LVAL val;
  827.   int sym, hsym;
  828.   
  829.   val = xlgetprop(lsym, s_symbol_index);
  830.   if (! consp(val) || !fixp(car(val)) || ! consp(cdr(val)) || ! fixp(car(cdr(val)))) {
  831.     sym = 4;
  832.     hsym = 5;
  833.   }
  834.   else {
  835.     sym = getfixnum(car(val));
  836.     hsym = getfixnum(car(cdr(val)));
  837.   }
  838.   if (psym != nil) *psym = sym;
  839.   if (phsym != nil) *phsym = hsym;
  840. }
  841.  
  842. LVAL encode_point_symbol(sym, hsym)
  843.      int sym, hsym;
  844. {
  845.   LVAL lsym;
  846.   
  847.   if (sym == 0 && hsym == 3) lsym = s_dotword;
  848.   else lsym = (LVAL) StGWGetSymRefCon(sym);
  849.   if (lsym != NIL && symbolp(lsym)) return(lsym);
  850.   else return(integer_list_2(sym, hsym));
  851. }
  852.  
  853. LVAL gw_draw_bitmap()
  854. {
  855.   StGWWinInfo *gwinfo; /* changed JKL */
  856.   char *image;
  857.   LVAL Limage;
  858.   int left, top, width, height;
  859.   
  860.   gwinfo = StGWObWinInfo(xlgaobject());
  861.   Limage = xsgetmatrix();
  862.   left = getfixnum(xlgafixnum());
  863.   top = getfixnum(xlgafixnum());
  864.   /*  xllastarg();*/ /* allow for optional mask bitmap */
  865.   
  866.   width = numcols(Limage);
  867.   height = numrows(Limage);
  868.   
  869.   if (width <= 0 || height <= 0) xlerror("bad bitmap data", Limage);
  870.   
  871.   image = make_image(Limage);
  872.   if (image != nil) {
  873.     StGWDrawBitmap(gwinfo, left, top, width, height, image);
  874.     free_image(image);
  875.   }
  876.   return(NIL);
  877. }
  878.